home *** CD-ROM | disk | FTP | other *** search
/ FM Towns: Free Software Collection 8 / FM Towns Free Software Collection 8.iso / fb386 / eiyoukei / eiychy83.bas < prev    next >
BASIC Source File  |  1994-06-01  |  32KB  |  765 lines
  1. 1000 'SAVE "EIYCHY83.BAS",A
  2. 1010 '栄養所要量集計とグラフ
  3. 1020 '          V8.0                  91.04.01
  4. 1021 ON ERROR GOTO *ERR
  5. 1023 CLEAR ,,,500000!:DSPSW=0:TOWNS=1:C899=1:ON ERROR GOTO *ERR
  6. 1024 SCREEN@ 0:WINDOW (0,0)-(639,479):VIEW (0,0)-(639,479)
  7. 1025 *FBHG GOSUB 1106:COLOR 7:GOSUB 10000:PRINT :PRINT
  8. 1026 PRINT "標準栄養所要量の変更をしますか｡":PRINT :PRINT :PRINT :PRINT 
  9. 1027 KEY 1,"ＰＦ１":KEY 2,"ＰＦ２"
  10. 1028 PRINT "ＰＦ１　変更する　　ＰＦ２　変更しない　":INWC=6
  11. 1030 GOSUB *INKEY1:IF X$="ＰＦ１" THEN 1050 ELSE 1060
  12. 1040 GOSUB 1740:':STOP '群別摂取量の読み込み
  13. 1050 GOSUB 2000:':STOP '標準栄養所要量の読み込み
  14. 1055 '
  15. 1060 GOSUB 1110':GOSUB 2290':STOP '成分表インデックス作成 
  16. 1080 GOSUB 1350':GOSUB 2290':STOP '調理表インデックス作成 
  17. 1090 GOSUB 1550':GOSUB 2290':STOP '献立表インデックス作成 
  18. 1100 GOSUB 2340:'GOSUB 2290:STOP '食品別栄養所要量の集計 
  19. 1105 CLOSE:RUN "EIYOUKEI.BAS"
  20. 1106 CLS:PALETTE 8,[80,64,128]:IF FMR=1 THEN COLOR 7,8,7,4 ELSE COLOR 7,%8,7,4
  21. 1107 RETURN
  22. 1110 '成分表インデックス作成　
  23. 1120 CLS
  24. 1130 OPEN "(128)SEIBUN.DAT" AS #3
  25. 1140 FIELD #3,0   AS DAMMY$,4  AS コード$
  26. 1150 FIELD #3,4   AS DAMMY$,16 AS 食品群$
  27. 1160 FIELD #3,20  AS DAMMY$,32 AS 成分表食品名$
  28. 1170 DIM SB$(23)
  29. 1180 FIELD #3,4 AS SB$(1),16 AS SB$(2),32 AS SB$(3)
  30. 1190 FOR I=4 TO 22:FIELD #3,4*(I-4)+52  AS DAMMY$,4  AS SB$(I):NEXT I
  31. 1200 ST=LOF(3):DIM SYOKUHINMEI$(ST):C150=ST
  32. 1205 JOHONO=1:JOHODAT$=STR$(ST):GOSUB 1302
  33. 1210 PRINT  "日本食品成分表は";ST;"件登録済です。"
  34. 1220 'PRINT "何かキーを押して下さい。":GOSUB *INKEY1
  35. 1230 IF ST=0 THEN PRINT "成分表が未登録です":GOTO 1300
  36. 1240 FOR I=1 TO ST
  37. 1250 GET #3,I
  38. 1251 LN=INSTR(SB$(3)," "):IF LN=0 THEN LN=32
  39. 1260 'SYOKUHINMEI$(I)=LEFT$(成分表食品名$,LN-1)
  40. 1265 SYOKUHINMEI$(I)=成分表食品名$
  41. 1270 PRINT USING "### &                                  &";I,SYOKUHINMEI$(I);
  42. 1280 NEXT I:PRINT
  43. 1290 'PRINT "何かキーを押して下さい。":GOSUB *INKEY1
  44. 1300 RETURN
  45. 1302 OPEN "(80)JOHO.DAT" AS #4
  46. 1304 FIELD #4,80 AS JH$:LSET JH$=JOHODAT$
  47. 1306 PUT #4,JOHONO
  48. 1308 CLOSE #4:RETURN
  49. 1350 '************************************************
  50. 1360 '
  51. 1370 '調理名ー食品名入力
  52. 1380 '
  53. 1390 CLS
  54. 1400 OPEN "(72)CYOURIWK.DAT" AS #2
  55. 1405 FIELD #2,72  AS CHWK$
  56. 1410 FIELD #2,0   AS DAMMY$,4  AS コード$,2 AS DLT$
  57. 1420 FIELD #2,4   AS DAMMY$,32 AS 調理表調理名$
  58. 1430 FIELD #2,36  AS DAMMY$,32 AS 調理表食品名$
  59. 1440 FIELD #2,68  AS DAMMY$,4  AS CSJ$
  60. 1441 OPEN "(72)CYOURI.DAT" AS #4
  61. 1442 FIELD #4,72  AS CHOR$
  62. 1443 LS=LOF(4)
  63. 1444 FOR I=1 TO LS:GET #4,I:LSET CHWK$=CHOR$:PUT #2,I:NEXT I:CLOSE #4
  64. 1450 DIM CHORIMEI$(RT+10),CHOINDX(RT+10)
  65. 1460 'DIM CHORISYOKUHINMEI$(C150),jg(C150)
  66. 1470 OC$="":J=0
  67. 1480 FOR I=1 TO LS
  68. 1490 GET #2,I
  69. 1500 IF CHR$(ASC(調理表調理名$))="*" THEN 1530
  70. 1510 IF OC$<>調理表調理名$ THEN J=J+1:CHORIMEI$(J)=調理表調理名$:CHOINDX(J)=I:PRINT USING "### &                                  &";J,CHORIMEI$(J);
  71. 1520 OC$=調理表調理名$
  72. 1530 NEXT I:RT=J
  73. 1531 CHOINDX(J+1)=LS+1
  74. 1535 JOHONO=2:JOHODAT$=STR$(RT):GOSUB 1302
  75. 1540 RETURN
  76. 1550 '
  77. 1560 '献立名ー調理名入力
  78. 1570 '
  79. 1580 CLS
  80. 1590 OPEN "(72)KONDATWK.DAT" AS #1
  81. 1595 FIELD #1,72  AS KNWK$
  82. 1600 FIELD #1,0   AS DAMMY$,4  AS コード$,2 AS DLT$
  83. 1610 FIELD #1,4   AS DAMMY$,32 AS 献立名$
  84. 1620 FIELD #1,36  AS DAMMY$,32 AS 献立表調理名$
  85. 1630 FIELD #1,68  AS DAMMY$,4  AS KCJ$
  86. 1631 OPEN "(72)KONDAT.DAT" AS #4
  87. 1632 FIELD #4,72  AS KNOR$
  88. 1633 KS=LOF(4)
  89. 1634 FOR I=1 TO KS:GET #4,I:LSET KNWK$=KNOR$:PUT #1,I:NEXT I:CLOSE #4
  90. 1640 DIM KONDATEMEI$(KT+10),KONINDX(KT+10)
  91. 1650 'DIM KONDATECHORIMEI$(C150),KCJ(C150)
  92. 1660 OC$="":J=0
  93. 1670 FOR I=1 TO KS
  94. 1680 GET #1,I
  95. 1690 IF CHR$(ASC(献立名$))="*" THEN 1720
  96. 1700 IF OC$<>献立名$ THEN J=J+1:KONDATEMEI$(J)=献立名$:KONINDX(J)=I:PRINT USING "### &                                  &";J,KONDATEMEI$(J);
  97. 1710 OC$=献立名$
  98. 1720 NEXT I:KT=J
  99. 1721 KONINDX(J+1)=KS+1
  100. 1725 JOHONO=3:JOHODAT$=STR$(KT):GOSUB 1302
  101. 1730 RETURN
  102. 1740 'SAVE "GUNBSEL.BAS",A
  103. 1750 '                          91.02.20
  104. 1760 '
  105. 1770 DIM GU$(15)
  106. 1780 OPEN "GUNBETU.DAT" FOR INPUT AS #4
  107. 1790 CONSOLE 6,15,0:COLOR 7
  108. 1800 LOCATE 0,23:PRINT "CR-次表示   SPACE-確定" 
  109. 1810 LOCATE 0,0
  110. 1820 FOR I=1 TO 5:LINE INPUT #4,A$:PRINT A$
  111. 1830 NEXT I
  112. 1840 LOCATE 0,6
  113. 1850 WHILE NOT EOF(4)
  114. 1860 LINE INPUT #4,A$:IF A$="" THEN 1910
  115. 1870 IF ASC(A$)=ASC("*") THEN 1910
  116. 1880 PRINT A$
  117. 1890 GOSUB *INKEY1
  118. 1900 IF X$=" " THEN 1920
  119. 1910 WEND:CLOSE #4:GOTO 1780'STOP
  120. 1920 RESTORE 1990:M=1
  121. 1930 FOR I=1 TO 15 
  122. 1940 READ N
  123. 1950 GU$(I)=MID$(A$,M,N):M=M+N+1:COLOR 4:PRINT GU$(I)+",";:COLOR 7
  124. 1960 NEXT I
  125. 1970 CLOSE #4:GOSUB *INKEY1
  126. 1980 RETURN
  127. 1990 DATA 7,2,8,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3
  128. 2000 'SAVE "EIYSSEL.BAS",A
  129. 2010 '                          91.02.20
  130. 2020 '
  131. 2030 'DIM SE$(15)
  132. 2040 OPEN "EIYSHYO.DAT" FOR INPUT AS #4
  133. 2050 CONSOLE 6,15,0:COLOR 7
  134. 2060 CLS:LOCATE 0,23:PRINT "CR-次表示   SPACE-確定" 
  135. 2070 LOCATE 0,0
  136. 2080 FOR I=1 TO 5:LINE INPUT #4,A$:PRINT A$
  137. 2090 NEXT I
  138. 2100 LOCATE 0,6
  139. 2110 WHILE NOT EOF(4)
  140. 2120 LINE INPUT #4,A$:IF A$="" THEN 2170
  141. 2130 IF ASC(A$)=ASC("*") THEN 2170
  142. 2140 PRINT A$
  143. 2150 GOSUB *INKEY1
  144. 2160 IF X$=" " THEN 2180
  145. 2170 WEND:CLOSE #4:GOTO 2040:STOP
  146. 2180 RESTORE 2250:M=1:KIJUNCHI$=A$
  147. 2190 FOR I=1 TO 13 
  148. 2200 READ N
  149. 2210 SE$(I)=MID$(A$,M,N):M=M+N+1:COLOR 4:PRINT SE$(I)+",";:COLOR 7
  150. 2220 NEXT I
  151. 2230 SE$(14)=" 10"
  152. 2240 CLOSE #4:
  153. 2250 DATA 7,2,8,5,3,4,3,5,4,4,3,3,4
  154. 2255 COLOR 4:PRINT "確認後 何かキーをおしてください。";:COLOR 7
  155. 2256 GOSUB *INKEY1
  156. 2260 RETURN
  157. 2290 '************************************************
  158. 2300 PRINT " ":PRINT "何かキーをおしてください。"
  159. 2310 GOSUB *INKEY1:RETURN
  160. 2340 '*******************************
  161. 2350 ' 食品別栄養所要量の集計 
  162. 2360 '          V2.0                  90.10.18
  163. 2361 'イニシャライズ 
  164. 2370 C15=8:C30=2*C15:DIM JG(C150+C15,14),SSJ(ST+C15),CSJ(RT+C15),KSJ(KT+C15),SE(14):PAI=3.1416!:C360=2*PAI
  165. 2371 C25=31:C16=19:JGL=0
  166. 2372 DIM KRST(3):KRST(1)=KT:KRST(2)=RT:KRST(3)=ST:DSW=3:ESW=0
  167. 2373 DIM SVJ(3):SVJ(1)=1:SVJ(2)=1:SVJ(3)=1'ポインタJの退避 
  168. 2374 DIM SSE(14),SEX(14)
  169. 2375 FOR NN=4 TO 14:JG(0,NN)=8*C25:NEXT NN:JG(0,2)=0
  170. 2376 DIM MESWD$(3,10),MESCL(3,10),MESSP(3):MESCL=7
  171. 2380 KEY 10,"終了"+CHR$(&H0D)
  172. 2390 KEY 1,"ＰＦ１"
  173. 2400 KEY 2,"ＰＦ２"
  174. 2410 KEY 3,"明細"
  175. 2411 KEY 4,"モード"
  176. 2412 KEY 10,"終了"
  177. 2414 KEY 5,"グラフ"
  178. 2415 KEY 6,"基準値"
  179. 2416 KEY 7,"クリア"
  180. 2417 KEY 8,"保存"
  181. 2419 KEY 9,"呼出"
  182. 2420 CLS:C4=0:CONSOLE C15,14,1
  183. 2430 LOCATE 0,C15+1
  184. 2440 RESTORE 2520
  185. 2450 PRINT "基準値   ";: FOR M=1 TO 3:PRINT SE$(M);"   ";:NEXT M:PRINT 
  186. 2460 PRINT       "              基準値    合 計                   100%"
  187. 2470 FOR M=4 TO 14:READ XX$
  188. 2480 RYO=VAL(SE$(M))
  189. 2490 IF M=6 THEN RYO=RYO*1000
  190. 2500 PRINT USING "&          & #####.#";XX$,RYO:SE(M)=RYO
  191. 2510 NEXT M:GOSUB 3195
  192. 2520 DATA エネルギー,たんぱく質,カルシュウム,鉄,ビタミンＡ
  193. 2530 DATA ビタミンＢ１,ビタミンＢ２,ナイアシン,ビタミンＣ,ビタミンＤ
  194. 2540 DATA 食塩 
  195. 2550 LOCATE 0,0
  196. 2560 '食品重量の入力
  197. 2570 CONO=1
  198. 2580 CLS 3:MESLN=2
  199. 2581 IF DSW=3 THEN MESWD$="食品の重量を入力してください｡"
  200. 2582 IF DSW=2 THEN MESWD$="調理の単位を入力してください｡"
  201. 2583 IF DSW=1 THEN MESWD$="献立の単位を入力してください｡"
  202. 2584 GOSUB *MES
  203. 2590 MESLN=3:MESWD$="データの一覧表示  ＥＳＣ　または　ＰＦ３":GOSUB *MES
  204. 2600 OI2=1:J=1:X=0:Y=C4:LOCATE X,Y
  205. 2610 FOR I10=1 TO C30:II=I10-1
  206. 2620 LOCATE X+40*(II \ C15),Y+II MOD C15
  207. 2630 PP=((J-1)\C30)*C30
  208. 2640 IF DSW=3 THEN SRKT=ST
  209. 2641 IF DSW=2 THEN SRKT=RT
  210. 2642 IF DSW=1 THEN SRKT=KT
  211. 2648 IF PP+I10>SRKT THEN 2680
  212. 2650 IF DSW=3 THEN B=SSJ(PP+I10):B$=SYOKUHINMEI$(PP+I10)
  213. 2651 IF DSW=2 THEN B=CSJ(PP+I10):B$=CHORIMEI$(PP+I10)
  214. 2652 IF DSW=1 THEN B=KSJ(PP+I10):B$=KONDATEMEI$(PP+I10)
  215. 2657 PRINT USING "###  ";PP+I10;:PRINT  B$;" ";
  216. 2658 IF B = 0 THEN 2680
  217. 2660 LOCATE X+40*(II \ C15)+28,Y+II MOD C15
  218. 2670 IF B>99999! THEN PRINT "*********"; ELSE PRINT USING  "#####.###";B;
  219. 2680 NEXT I10
  220. 2690 GOSUB 2720
  221. 2691 IF KSW=0 THEN 2610 
  222. 2692 IF KSW=1 THEN KSW=0:GOTO 2560
  223. 2693 IF KSW=2 THEN KSW=0:RETURN
  224. 2700 STOP
  225. 2710 '*************************************************
  226. 2720 XX=-1:YY=-1:P=((I10-1) \ C30)+1
  227. 2730 JJ=J-1:P=J:OXX=XX:OYY=YY
  228. 2740 XX=X+40*((JJ \ C15) MOD 2):YY=Y+JJ MOD C15
  229. 2750 IF NOT(OXX=-1 AND OYY=-1) THEN LOCATE OXX,OYY:PRINT USING "###  ";OI2;
  230. 2760 LOCATE XX,YY:COLOR 2:PRINT USING "###★";J;:COLOR 7:OI2=J
  231. 2770 GOSUB *INKEY
  232. 2771 IF X$="モード" THEN GOSUB 9700:RETURN'入力モード切替え 
  233. 2772 IF X$="基準値" THEN GOSUB 9000:RETURN'標準値切替え 
  234. 2773 IF X$="呼出" THEN GOSUB 3160:GOSUB *YOM:X$=CHR$(&H1B):GOTO 2771
  235. 2775 IF X$="終了" THEN KSW=2:GOTO 2885
  236. 2780 IF X$=CHR$(&H1F) THEN J=J+1
  237. 2790 IF X$=CHR$(&H1E) THEN J=J-1
  238. 2800 IF X$=CHR$(&H1D) THEN J=J-C15
  239. 2810 IF X$=CHR$(&H1C) THEN J=J+C15
  240. 2820 IF (X$>=CHR$(&H30) AND X$=<CHR$(&H39)) OR X$=CHR$(&H2E) THEN GOSUB 2930:GOTO 2771
  241. 2830 IF X$=CHR$(&H1B) OR X$="明細" THEN GOSUB 10800:GOSUB 9780:IF KSW=1 THEN RETURN ELSE CLS 2:RETURN
  242. 2840 IF X$=CHR$(&H09) THEN KSW=1:GOTO 2885
  243. 2850 IF J<1 THEN J=SRKT
  244. 2860 IF J>SRKT THEN J=1
  245. 2870 IF (J-1)\C30<>(P-1)\C30 THEN CLS 2:RETURN
  246. 2880 GOTO 2730
  247. 2885 RETURN
  248. 2930 '************************************************
  249. 2940 XSUINP=XX:YSUINP=YY
  250. 2975 GOSUB *SUINP
  251. 2990 CSJ=OSUINP
  252. 2991 IF DSW=3 THEN SSJ(J)=CSJ
  253. 2992 IF DSW=2 THEN CSJ(J)=CSJ
  254. 2993 IF DSW=1 THEN KSJ(J)=CSJ
  255. 3005 GOSUB 5000
  256. 3010 RETURN 
  257. 3020 '食品一覧表示
  258. 3030 CLS 3:II3=0:CLS 2:X=0:Y=C4
  259. 3035 IF JGL=0 THEN 3130
  260. 3040 FOR LL=1 TO JGL
  261. 3050 IF JG(LL,3) = 0 THEN 3120
  262. 3060 LOCATE X+40*((II3 \ C15) MOD 2),Y+II3 MOD C15
  263. 3070 PRINT USING  "####";JG(LL,1);
  264. 3075 COLOR JG(LL,2):PRINT "●";:COLOR 7
  265. 3076 IF JG(LL,0)=3 THEN PRINT  SYOKUHINMEI$(JG(LL,1));
  266. 3077 IF JG(LL,0)=2 THEN PRINT  CHORIMEI$(JG(LL,1));
  267. 3078 IF JG(LL,0)=1 THEN PRINT  KONDATEMEI$(JG(LL,1));
  268. 3080 LOCATE X+40*((II3 \ C15)MOD 2)+28,Y+II3 MOD C15
  269. 3090 IF JG(LL,3)>99999! THEN PRINT "*********"; ELSE PRINT USING  "#####.###";JG(LL,3);
  270. 3100 II3=II3+1
  271. 3110 IF II3 MOD C30 = 0 THEN MESLN=2:GOSUB *MPUSH:MESCL=4:MESWD$="なにかキーを押してください。":GOSUB *MES:GOSUB *INKEY:CLS 2:MESLN=2:GOSUB *MPOP
  272. 3115 IF X$="終了" THEN KSW=2:GOTO 3150
  273. 3120 NEXT LL
  274. 3130 MESLN=3:GOSUB *MPUSH:MESCL=7:MESWD$="クリアー  ＰＦ１　入力画面　ＰＦ２　":GOSUB *MES:GOSUB *INKEY:MESLN=3:GOSUB *MPOP
  275. 3135 IF X$="終了" THEN KSW=2:GOTO 3150
  276. 3140 IF X$="ＰＦ１" THEN GOSUB 3160:KSW=1 ELSE KSW=0
  277. 3150 RETURN
  278. 3160 'テーブルクリアー
  279. 3165 FOR NN=0 TO 3:FOR XX=1 TO C150:JG(XX,NN)=0:NEXT XX:NEXT NN:CLS 2
  280. 3166 FOR NN=4 TO 14:JG(0,NN)=8*C25:NEXT NN:JG(0,2)=0
  281. 3167 JGL=0
  282. 3175 FOR XX=0 TO ST+C15:SSJ(XX)=0:NEXT XX
  283. 3176 FOR XX=0 TO RT+C15:CSJ(XX)=0:NEXT XX
  284. 3177 FOR XX=0 TO KT+C15:KSJ(XX)=0:NEXT XX
  285. 3179 FOR NN=4 TO 14
  286. 3180 LOCATE 22,C15-2+NN:PRINT "               ";
  287. 3181 STX=8*C25:STY=(C15-2+NN)*C16:LTX=STX:LTY=STY+C16
  288. 3182 IF FMR=1 THEN LINE (STX,STY)-(640,LTY),PSET,8,BF
  289. 3183 IF TOWNS=1 THEN LINE (STX,STY)-(640,LTY),PSET,%8,BF
  290. 3185 NEXT NN
  291. 3186 GOSUB 3195
  292. 3189 RETURN
  293. 3190 GOSUB *INKEY:PRINT HEX$(ASC(X$)):GOTO 3190 
  294. 3195 *KLINE IF ESW=0 THEN C12=2*80:LINE (8*C25+C12,(C15-2+4)*C16)-(8*C25+C12+1,(C15-2+14)*C16+10),PSET,4,BF
  295. 3196 RETURN
  296. 3200 '食品重量計算 
  297. 5000 *J HENSW=0:CN80=80:IF JGL=0 THEN 5050
  298. 5010 FOR LL=1 TO JGL
  299. 5020 IF JG(LL,1)=J AND JG(LL,0)=DSW THEN JGW=LL:GOTO 5090
  300. 5030 NEXT LL
  301. 5040 IF CSJ=0 THEN 5180
  302. 5050 JGL=JGL+1:JGW=JGL
  303. 5060 GOSUB 6000:HENSW=0:GOSUB 7000:GOTO 5180
  304. 5090 HENSW=1
  305. 5100 IF CSJ=0 THEN 5130
  306. 5110 FOR NN=4 TO 14:JG(JGW,NN)=JG(JGW,NN)*CSJ/JG(JGW,3):NEXT NN
  307. 5115 JG(JGW,3)=CSJ
  308. 5120 GOSUB 7000:HENSW=0:GOTO 5180
  309. 5130 IF JGL=JGW THEN 5155
  310. 5135 FOR LL=JGW TO JGL-1
  311. 5140 FOR NN=0 TO 14:JG(LL,NN)=JG(LL+1,NN):NEXT NN
  312. 5150 NEXT LL
  313. 5155 JGL=JGL-1:GOTO 5120
  314. 5180 RETURN
  315. 6000 '
  316. 6010 MFD=0:FOR NN=0 TO 14:SSE(NN)=0:NEXT NN:DT0=1:DT1=1:DT2=1
  317. 6020 IF DSW=1 THEN PT0=J:DT0=CSJ:GOSUB 8000:GOTO 6050 ELSE DT1=1
  318. 6030 IF DSW=2 THEN PT1=J:DT1=CSJ:GOSUB 8110:GOTO 6050 ELSE DT2=1
  319. 6040 IF DSW=3 THEN PT2=J:DT2=CSJ:GOSUB 8210:GOTO 6050 ELSE STOP
  320. 6050 JG(JGW,1)=J:JG(JGW,0)=DSW
  321. 6060 JG(JGW,2)=(JG(JGW-1,2) MOD 6)+1
  322. 6070 JG(JGW,3)=CSJ
  323. 6080 FOR NN=4 TO 14:JG(JGW,NN)=SSE(NN):NEXT NN
  324. 6090 RETURN
  325. 6100 '
  326. 7000 *K1'グラフ表示と数字表示
  327. 7005 IF ESW=1 OR ESW=2 THEN GOSUB *SUH:GOSUB *ENG:GOTO 7220 
  328. 7010 FOR NN=4 TO 14:SSE=0
  329. 7015 IF JGL=0 THEN 7030
  330. 7020 FOR LL=1 TO JGL:SSE=SSE+JG(LL,NN):NEXT LL
  331. 7030 LOCATE 22,C15-2+NN
  332. 7035 IF SSE>1E+06 THEN PRINT "********"; ELSE PRINT USING "######.#";SSE;
  333. 7040 STX=8*C25:STY=(C15-2+NN)*C16:LTX=STX:LTY=STY+10
  334. 7050 IF HENSW=0 THEN 7160 ELSE IF HENSW=2 THEN DY=5 ELSE DY=0
  335. 7065 IF JGL=0 AND FMR=1 THEN LINE (STX,STY+DY)-(JG(0,NN),LTY),PSET,8,BF:GOSUB 3195:GOTO 7130
  336. 7066 IF JGL=0 AND TOWNS=1 THEN LINE (STX,STY+DY)-(JG(0,NN),LTY),PSET,%8,BF:GOSUB 3195:GOTO 7130
  337. 7070 FOR LL=1 TO JGL
  338. 7080 NAGS=2*CN80*JG(LL,NN)/SE(NN):IF NAGS<.5! THEN 7120
  339. 7090 LTX=STX+NAGS:IF LTX>639 THEN LTX=639
  340. 7100 LINE (STX,STY+DY)-(LTX,LTY),PSET,JG(LL,2),BF
  341. 7110 STX=LTX
  342. 7120 NEXT LL
  343. 7125 IF JG(0,NN)>LTX AND FMR=1 THEN LINE (LTX+1,STY+DY)-(JG(0,NN),LTY),PSET,8,BF:GOSUB 3195
  344. 7126 IF JG(0,NN)>LTX AND TOWNS=1 THEN LINE (LTX+1,STY+DY)-(JG(0,NN),LTY),PSET,%8,BF:GOSUB 3195
  345. 7130 IF HENSW<>2 THEN JG(0,NN)=LTX
  346. 7140 NEXT NN
  347. 7150 IF HENSW=0 OR HENSW=1 THEN 7220
  348. 7152 MESLN=3:GOSUB *MPUSH:MESWD$="確認後、何かキーを押して下さい。":GOSUB *MES:GOSUB *INKEY:MESLN=3:GOSUB *MPOP:HENSW=1:GOTO 7010
  349. 7160 DY=0:LL=JGL
  350. 7170 NAGS=2*CN80*JG(LL,NN)/SE(NN):IF NAGS<.5! THEN 7140
  351. 7180 STX=JG(0,NN):LTX=STX+NAGS
  352. 7190 IF LTX>639 THEN LTX=639
  353. 7200 LINE (STX,STY)-(LTX,LTY),PSET,JG(LL,2),BF
  354. 7210 GOTO 7130
  355. 7220 RETURN
  356. 8000 RE1=KONINDX(PT0)
  357. 8010 IF LOF(1)>0 THEN GET #1,RE1 ELSE GOSUB 8070:MFD=1:GOTO 8060
  358. 8020  PT1$=献立名$:DT1=CVS(KCJ$)
  359. 8025 PT1=SEARCH(CHORIMEI$,献立表調理名$):IF PT1=-1 THEN 8081
  360. 8030 GOSUB 8110
  361. 8040 IF MFD=1 THEN 8060
  362. 8050 RE1=RE1+1:IF RE1>LOF(1) THEN 8060
  363. 8055 GET #1,RE1:IF PT1$=献立名$ THEN 8020
  364. 8060 RETURN
  365. 8070 RESTORE 8080:GOSUB 8090:GOTO 8060
  366. 8080 DATA "献立表に献立名がありません｡"
  367. 8081 RESTORE 8190:GOSUB 8090:GOTO 8060
  368. 8090 MESLN=2:MESCL=2:GOSUB *MPUSH:READ MESWD$:GOSUB *MES:GOSUB *INKEY:MESLN=2:GOSUB *MPOP:RETURN
  369. 8100 '
  370. 8110 RE2=CHOINDX(PT1)
  371. 8120 IF LOF(2)>0 THEN GET #2,RE2 ELSE GOSUB 8180:MFD=1:GOTO 8170
  372. 8130  PT2$=調理表調理名$:DT2=CVS(CSJ$)
  373. 8135 PT2=SEARCH(SYOKUHINMEI$,調理表食品名$):IF PT2=-1 THEN 8191
  374. 8140 GOSUB 8210
  375. 8150 IF MFD=1 THEN 8180
  376. 8160 RE2=RE2+1:IF RE2>LOF(2) THEN 8170
  377. 8165 GET #2,RE2:IF PT2$=調理表調理名$ THEN 8130
  378. 8170 RETURN
  379. 8180 RESTORE 8190:GOSUB 8090:GOTO 8170
  380. 8190 DATA "調理表に調理名がありません｡"
  381. 8191 RESTORE 8290:GOSUB 8090:GOTO 8170
  382. 8200 '
  383. 8210 RE3=PT2
  384. 8220 IF LOF(3)>0 THEN GET #3,RE3 ELSE GOSUB 8280:MFD=1:GOTO 8270
  385. 8230  PT3$=成分表食品名$
  386. 8235 KEIS=DT0*DT1*DT2
  387. 8240 GOSUB 8310
  388. 8260 RE3=RE3+1:IF RE3>LOF(3) THEN 8270
  389. 8265 GET #3,RE3:IF PT3$=SB$(3) THEN 8240
  390. 8270 RETURN
  391. 8280 RESTORE 8290:GOSUB 8090:GOTO 8270
  392. 8290 DATA "成分表に食品名がありません｡"
  393. 8300 '
  394. 8310 RESTORE 8320
  395. 8320 DATA 4,6,10,11,16,17,18,19,20,21,23
  396. 8330 FOR NN=4 TO 13:READ MM:SSE(NN)=SSE(NN)+KEIS*CVS(SB$(MM))/100:NEXT NN
  397. 8340 SSE(14)=SSE(14)+2.54!*KEIS*CVS(SB$(12))/1000/100
  398. 8350 RETURN
  399. 9000 'SAVE "栄養基準値の選択 
  400. 9005 MESLN=0:GOSUB *MPUSH:MESLN=1:MESWD$=KIJUNCHI$:GOSUB *MES
  401. 9010 MESLN=3:MESWD$="確定 ＰＦ１　　選択 ＰＦ２":GOSUB *MES
  402. 9040 OPEN "EIYSHYO.DAT" FOR INPUT AS #4
  403. 9110 WHILE NOT EOF(4)
  404. 9120 LINE INPUT #4,A$:IF A$="" THEN 9170
  405. 9130 IF ASC(A$)=ASC("*") THEN 9170
  406. 9140 LOCATE 0,22:COLOR 4:PRINT A$;:COLOR 7
  407. 9150 GOSUB *INKEY
  408. 9160 IF X$="ＰＦ１" THEN 9180
  409. 9170 WEND:CLOSE #4:GOTO 9000:STOP
  410. 9180 RESTORE 9250:M=1
  411. 9190 KIJUNCHI$=A$:LOCATE 0,22:COLOR 2:FOR I=1 TO 13 
  412. 9200 READ N
  413. 9210 SE$(I)=MID$(A$,M,N):M=M+N+1:PRINT SE$(I)+",";
  414. 9220 NEXT I
  415. 9230 SE$(14)=" 10":PRINT SE$(14);:COLOR 7
  416. 9240 CLOSE #4:GOTO 9430
  417. 9250 DATA 7,2,8,5,3,4,3,5,4,4,3,3,4
  418. 9430 LOCATE 0,C15+1
  419. 9450 COLOR 2:PRINT "基準値   ";: FOR M=1 TO 3:PRINT SE$(M);"   ";:NEXT M:PRINT:COLOR 7 
  420. 9470 FOR M=4 TO 14
  421. 9480 RYO=VAL(SE$(M))
  422. 9490 IF M=6 THEN RYO=RYO*1000
  423. 9500 LOCATE 13,C15-2+M:PRINT USING "#####.#";RYO;:SE(M)=RYO
  424. 9510 NEXT M:HENSW=2:GOSUB 7000:HENSW=0
  425. 9520 LOCATE 0,C15
  426. 9530 PRINT "基準値   ";: FOR M=1 TO 3:PRINT SE$(M);"   ";:NEXT M:PRINT 
  427. 9541 PRINT       "              基準値    合 計                   100%"
  428. 9550 MESLN=1:MESWD$=" ":GOSUB *MES
  429. 9551 MESLN=0:GOSUB *MPOP
  430. 9600 RETURN
  431. 9700 '入力モード切替え 
  432. 9710 SVJ(DSW)=J:DSW=(DSW MOD 3)+1:J=SVJ(DSW):CLS 2:KSW=0
  433. 9780 MESLN=2
  434. 9781 IF DSW=3 THEN MESWD$="食品の重量を入力してください｡"
  435. 9782 IF DSW=2 THEN MESWD$="調理の単位を入力してください｡"
  436. 9783 IF DSW=1 THEN MESWD$="献立の単位を入力してください｡"
  437. 9784 GOSUB *MES
  438. 9790 MESLN=3:MESWD$="データの一覧表示  ＥＳＣ　 明細　ＰＦ３　":GOSUB *MES
  439. 9795 RETURN
  440. 10000 '
  441. 10010 CONSOLE 0,25,0:CLS:DIM SE$(15)
  442. 10020 OPEN "(80)JOHO.DAT" AS #4
  443. 10030 FIELD #4,80 AS A$
  444. 10040 GET #4,1:ST=VAL(A$)+10
  445. 10050 GET #4,2:RT=VAL(A$)+10
  446. 10060 GET #4,3:KT=VAL(A$)+10
  447. 10065 FOR IR=4 TO 8:GET #4,IR:PRINT A$;:NEXT IR
  448. 10070 GET #4,9:PRINT A$;:KIJUNCHI$=A$
  449. 10080 RESTORE 10140:M=1
  450. 10090 FOR I=1 TO 13 
  451. 10100 READ N
  452. 10110 SE$(I)=MID$(A$,M,N):M=M+N+1:COLOR 4:PRINT SE$(I)+",";:COLOR 7
  453. 10120 NEXT I:PRINT 
  454. 10130 SE$(14)=" 10"
  455. 10140 DATA 7,2,8,5,3,4,3,5,4,4,3,3,4
  456. 10150 '
  457. 10160 DIM GU$(15)
  458. 10170 RESTORE 10230:M=1
  459. 10175 FOR IR=10 TO 14:GET #4,IR:PRINT A$;:NEXT IR
  460. 10180 GET #4,15:PRINT A$;
  461. 10190 FOR I=1 TO 15 
  462. 10200 READ N
  463. 10210 GU$(I)=MID$(A$,M,N):M=M+N+1:COLOR 4:PRINT GU$(I)+",";:COLOR 7
  464. 10220 NEXT I:PRINT 
  465. 10230 DATA 7,2,8,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3
  466. 10240 CLOSE #4
  467. 10250 RETURN
  468. 10300 '文字入力ルーチンノ
  469. 10305 *INKEY
  470. 10310 OINWX$=INWX$:INWX$=""
  471. 10330 *INK1 W$=INKEY$:IF W$="" THEN *INK1
  472. 10340   INWX$=INWX$+W$
  473. 10350   IF W$=CHR$(&H0D) THEN *INK3
  474. 10370 *INK2 W$=INKEY$:IF W$<>"" THEN INWX$=INWX$+W$:GOTO *INK2
  475. 10390 *INK3 X$=INWX$
  476. 10391 IF X$="グラフ" THEN GOSUB *ESW:GOTO *INKEY
  477. 10395 IF X$="終了" THEN CLOSE:RUN "EIYOUKEI.BAS"
  478. 10396 IF X$="クリア" THEN GOSUB 3160:X$=CHR$(&H1B):GOTO *INKE
  479. 10397 IF X$="保存" THEN GOSUB *HOZON:GOTO *INKEY
  480. 10399 *INKE RETURN
  481. 10400 '数字編集入力 
  482. 10410 *SUINP
  483. 10420 WW$="":XXW=XSUINP+28:ESCSW=0:LOCATE XXW,YSUINP:PRINT "          ";
  484. 10430 *SU1 LOCATE XXW,YSUINP
  485. 10440 IF NOT((X$>=CHR$(&H30) AND X$=<CHR$(&H39)) OR X$=CHR$(&H2E)) THEN *SU2
  486. 10450 WW$=WW$+X$:IF LEN(WW$)<10 THEN PRINT X$;:XXW=XXW+1
  487. 10460 *SU2 GOSUB *INKEY
  488. 10470 IF X$="終了" THEN KSW=2:GOTO *SU3
  489. 10480 IF X$=CHR$(&H1B) THEN ESCSW=1:GOTO *SU3
  490. 10490 IF NOT(X$=>CHR$(&H1C) AND X$=<CHR$(&H1F)) THEN *SU1
  491. 10500 OSUINP=VAL(WW$)
  492. 10510 LOCATE XSUINP+28,YSUINP
  493. 10520 IF OSUINP>99999! THEN PRINT "*********"; ELSE PRINT USING "#####.###";OSUINP;
  494. 10530 *SU3 RETURN
  495. 10600 'メッマセージルーチン
  496. 10610 *MES
  497. 10620 MESWD$(MESLN,MESSP(MESLN))=MESWD$
  498. 10630 MESCL(MESLN,MESSP(MESLN))=MESCL
  499. 10640 LOCATE 0,MESLN+20:COLOR MESCL:
  500. 10650 PRINT USING "&                                                                       &";MESWD$;:COLOR 7:MESCL=7
  501. 10660 GOTO *MESEXIT
  502. 10670 *MPUSH
  503. 10680 FOR MI=1 TO 3
  504. 10690 IF MESLN=0 OR MESLN=MI THEN MESSP(MI)=(MESSP(MI)+1) MOD 11
  505. 10700 NEXT MI
  506. 10710 GOTO *MESEXIT
  507. 10720 *MPOP
  508. 10730 FOR MI=1 TO 3
  509. 10740 IF MESLN=0 OR MESLN=MI THEN MESSP(MI)=(MESSP(MI)+10) MOD 11:COLOR MESCL(MI,MESSP(MI)):LOCATE 0,MI+20:PRINT USING "&                                                                       &";MESWD$(MI,MESSP(MI));:COLOR 7
  510. 10750 NEXT MI
  511. 10760 GOTO *MESEXIT
  512. 10770 *MESEXIT RETURN
  513. 10800 'テーブル一覧表示入力
  514. 10810 '数字入力テーブル変更ファイル書き換えグラフ確認表示再表示機能追加版
  515. 10820 *TBD IF JGL=0 THEN RETURN
  516. 10830 MESLN=0:GOSUB *MPUSH
  517. 10840 CLS 2:TJ=1:TOP=0:TJL=JGL:TX=0:TY=C4
  518. 10850 MESLN=3:MESWD$="テーブルクリア ＰＦ１ もとの画面に戻る ＰＦ２ 明細 ＥＳＣ":GOSUB *MES
  519. 10860 *TBD0 TP=((TJ-1) \ C30)+1:IF TP=TOP THEN *TBD2
  520. 10870 *TBD01 CLS 2:TI=(TP-1)*C30+1
  521. 10880 *TBD12 LOCATE TX+40*(((TI-1) \ C15) MOD 2),TY+((TI-1) MOD C15)
  522. 10890 PRINT USING "####";JG(TI,1);:COLOR JG(TI,2):PRINT "●";:COLOR 7
  523. 10900 IF JG(TI,0)=1 THEN PRINT  KONDATEMEI$(JG(TI,1));
  524. 10910 IF JG(TI,0)=2 THEN PRINT  CHORIMEI$(JG(TI,1));
  525. 10920 IF JG(TI,0)=3 THEN PRINT  SYOKUHINMEI$(JG(TI,1));
  526. 10930 LOCATE TX+40*(((TI-1) \ C15)MOD 2)+28,TY+(TI-1) MOD C15
  527. 10940 IF JG(TI,3)>99999! THEN PRINT "*********"; ELSE PRINT USING  "#####.###";JG(TI,3);
  528. 10950 IF (TI MOD C30)=0 OR TI=TJL THEN *TBD3 ELSE TI=TI+1:GOTO *TBD12
  529. 10960 *TBD2 LOCATE TX+40*(((TOJ-1) \ C15) MOD 2),TY+(TOJ-1) MOD C15
  530. 10970 PRINT USING  "####";JG(TOJ,1);:COLOR JG(TOJ,2):PRINT "●";:COLOR 7:GOTO *TBD3
  531. 10980 *TBD3 TXX=TX+40*(((TJ-1) \ C15) MOD 2):TYY=TY+(TJ-1) MOD C15
  532. 10985 LOCATE TXX,TYY
  533. 10990 COLOR JG(TJ,2):PRINT USING "####";JG(TJ,1);:PRINT "○";:COLOR 7
  534. 10991 MESLN=2
  535. 10992 IF JG(TJ,0)=3 THEN MESWD$="食品の重量を入力してください｡"
  536. 10993 IF JG(TJ,0)=2 THEN MESWD$="調理の単位を入力してください｡"
  537. 10994 IF JG(TJ,0)=1 THEN MESWD$="献立の単位を入力してください｡"
  538. 10995 GOSUB *MES
  539. 11000 *TBD4 GOSUB *INKEY
  540. 11010 IF X$>=CHR$(&H1C) AND X$<=CHR$(&H1F) THEN *TBD5
  541. 11020 IF X$="ＰＦ２" THEN KSW=0:GOTO *TBDE
  542. 11030 IF X$="終了" THEN KSW=2:GOTO *TBDE      '復帰
  543. 11040 IF X$="ＰＦ１" THEN GOSUB 3160:KSW=1:GOTO *TBDE'テーブルクリア
  544. 11050 IF (X$=CHR$(&H1B) OR X$="明細") AND JG(TJ,0)=1 THEN IX1=JG(TJ,1):KCLN=JG(TJ,2):GOSUB *FKR:TOP=0:GOTO *TBD51
  545. 11060 IF (X$=CHR$(&H1B) OR X$="明細") AND JG(TJ,0)=2 THEN IX2=JG(TJ,1):CCLN=JG(TJ,2):GOSUB *FCR:TOP=0:GOTO *TBD51
  546. 11070 IF (X$=CHR$(&H1B) OR X$="明細") AND JG(TJ,0)=3 THEN GOTO *TBD4
  547. 11080 IF (X$>=CHR$(&H30) AND X$<=CHR$(&H39)) OR X$=CHR$(&H2E) THEN GOSUB *TBK:IF CSJ=0 THEN TJ=TJ-1:TJL=TJL-1:IF TJL=0 THEN *TBDE ELSE TOP=0:GOTO *TBD51 ELSE *TBD5
  548. 11090 KSW=0:GOTO *TBDE
  549. 11100 *TBD5 TOP=TP:TOJ=TJ
  550. 11105 *TBD51 I=TJ:IL=TJL:GOSUB *CASCON:TJ=I:GOTO *TBD0
  551. 11110 *TBDE MESLN=0:GOSUB *MPOP:RETURN
  552. 11120 '
  553. 11200 *CASCON
  554. 11210 IF X$=CHR$(&H1F) THEN I=I+1
  555. 11220 IF X$=CHR$(&H1E) THEN I=I-1
  556. 11230 IF X$=CHR$(&H1D) THEN I=I-C15
  557. 11240 IF X$=CHR$(&H1C) THEN I=I+C15
  558. 11250 IF I<1 THEN I=IL
  559. 11260 IF I>IL THEN I=1
  560. 11270 RETURN
  561. 11300 *TBK
  562. 11380 MESLN=0:GOSUB *MPUSH':MESLN=2
  563. 11381 'IF JG(TJ,0)=3 THEN MESWD$="食品の重量を入力してください｡"
  564. 11382 'IF JG(TJ,0)=2 THEN MESWD$="調理の単位を入力してください｡"
  565. 11383 'IF JG(TJ,0)=1 THEN MESWD$="献立の単位を入力してください｡"
  566. 11384 'GOSUB *MES
  567. 11390 XSUINP=TXX:YSUINP=TYY:GOSUB *SUINP:CSJ=OSUINP
  568. 11396 IF JG(TJ,0)=3 THEN SSJ(JG(TJ,1))=CSJ
  569. 11397 IF JG(TJ,0)=2 THEN CSJ(JG(TJ,1))=CSJ
  570. 11398 IF JG(TJ,0)=1 THEN KSJ(JG(TJ,1))=CSJ
  571. 11399 JGW=TJ:GOSUB 5090
  572. 11400 MESLN=0:GOSUB *MPOP
  573. 11410 RETURN
  574. 11500 '献立ファイル一覧表示入力
  575. 11510 '数字入力献立ファイルル変更ファイル書き換えグラフ確認表示再表示機能追加版
  576. 11520 *FKR IF JGL=0 THEN RETURN
  577. 11530 MESLN=0:GOSUB *MPUSH
  578. 11540 M$=KONDATEMEI$(JG(TJ,1)):LN=INSTR(M$," "):MESCL=4
  579. 11542 MESLN=1:MESWD$=LEFT$(M$,LN-1)+"の明細を表示します。変更も可能です。"
  580. 11550 GOSUB *MES:
  581. 11560 STP1=KONINDX(IX1):LPT1=KONINDX(IX1+1)-1:KJL=(LPT1-STP1)+1
  582. 11570 *FKR01 CLS 2:KJ=1:KOP=0:KX=0:KY=C4
  583. 11580 MESLN=3:MESWD$="もとの画面に戻る ＰＦ２ 明細 ＥＳＣ":GOSUB *MES
  584. 11590 *FKR0 KP=((KJ-1) \ C30)+1:IF KP=KOP THEN *FKR2
  585. 11600 CLS 2:KI=(KP-1)*C30+1
  586. 11610 *FKR12 LOCATE KX+40*(((KI-1) \ C15) MOD 2),KY+((KI-1) MOD C15)
  587. 11620 PRINT USING "####";KI;:COLOR KCLN:PRINT "●";:COLOR 7
  588. 11630 GET #1,STP1+KI-1:PRINT 献立表調理名$;:KW=CVS(KCJ$)
  589. 11640 LOCATE KX+40*(((KI-1) \ C15)MOD 2)+28,KY+(KI-1) MOD C15
  590. 11650 IF KW>99999! THEN PRINT "*********"; ELSE PRINT USING  "#####.###";KW;
  591. 11655 IF (KI MOD C30)=0 OR KI=KJL THEN *FKR3 ELSE KI=KI+1:GOTO *FKR12
  592. 11660 *FKR2 LOCATE KX+40*(((KOJ-1) \ C15) MOD 2),KY+(KOJ-1) MOD C15
  593. 11670 PRINT USING  "####";KOJ;:COLOR KCLN:PRINT "●";:COLOR 7:GOTO *FKR3
  594. 11680 *FKR3 KXX=KX+40*(((KJ-1) \ C15) MOD 2):KYY=KY+(KJ-1) MOD C15
  595. 11685 LOCATE KXX,KYY
  596. 11690 COLOR KCLN:PRINT USING "####";KJ;:PRINT "○";:COLOR 7
  597. 11695 MESLN=2:MESWD$="調理の単位を入力してください｡":GOSUB *MES
  598. 11700 *FKR4 GOSUB *INKEY
  599. 11710 IF X$>=CHR$(&H1C) AND X$<=CHR$(&H1F) THEN *FKR5
  600. 11720 IF X$="ＰＦ２" THEN KSW=0:GOTO *FKRE
  601. 11730 IF X$="終了" THEN KSW=2:GOTO *FKRE      '復帰
  602. 11740 IF (X$=CHR$(&H1B) OR X$="明細") THEN GET #1,STP1+KJ-1:IX2=SEARCH(CHORIMEI$,献立表調理名$):CCLN=JG(TJ,2):GOSUB *FCR:KOP=0:GOTO *FKR51
  603. 11750 IF (X$>=CHR$(&H30) AND X$<=CHR$(&H39)) OR X$=CHR$(&H2E) THEN GOSUB *KBK:GOTO *FKR5
  604. 11760 KSW=0:GOTO *FKRE
  605. 11770 *FKR5 KOP=KP:KOJ=KJ
  606. 11775 *FKR51 I=KJ:IL=KJL:GOSUB *CASCON:KJ=I:GOTO *FKR0
  607. 11780 *FKRE MESLN=0:GOSUB *MPOP:RETURN
  608. 11800 *KBK
  609. 11810 XSUINP=KXX:YSUINP=KYY:GOSUB *SUINP:KCJ=OSUINP
  610. 11820 GET #1,STP1+KJ-1:LSET KCJ$=MKS$(KCJ):PUT #1,STP1+KJ-1
  611. 11825 MFD=0:FOR NN=0 TO 14:SSE(NN)=0:NEXT NN:DT0=1:DT1=1:DT2=1
  612. 11830 SVJ=J:SVJGW=JGW:SVCSJ=CSJ:SVDSW=DSW
  613. 11832 J=JG(TJ,1):JGW=TJ:CSJ=JG(TJ,3):DSW=JG(TJ,0):GOSUB 11910:HENSW=1:GOSUB 5000
  614. 11835 J=SVJ:JGW=SVJGW:CSJ=SVCSJ:DSW=SVDSW
  615. 11840 *KBKE RETURN
  616. 11900 '
  617. 11910 MFD=0:FOR NN=0 TO 14:SSE(NN)=0:NEXT NN:DT0=1:DT1=1:DT2=1
  618. 11920 IF DSW=1 THEN PT0=J:DT0=CSJ:GOSUB 8000:GOTO 11980 ELSE DT1=1
  619. 11930 IF DSW=2 THEN PT1=J:DT1=CSJ:GOSUB 8110:GOTO 11980 ELSE DT2=1
  620. 11940 IF DSW=3 THEN PT2=J:DT2=CSJ:GOSUB 8210:GOTO 11980 ELSE STOP
  621. 11970 'JG(JGW,3)=CSJ
  622. 11980 FOR NN=4 TO 14:JG(JGW,NN)=SSE(NN):NEXT NN
  623. 11990 RETURN
  624. 12000 '調理ファイル一覧表示入力
  625. 12010 '数字入力調理ファイルル変更ファイル書き換えグラフ確認表示再表示機能追加版
  626. 12020 *FCR IF JGL=0 THEN RETURN
  627. 12030 MESLN=0:GOSUB *MPUSH
  628. 12040 IF JG(TJ,0)=2 THEN M$=CHORIMEI$(JG(TJ,1)) ELSE M$=CHORIMEI$(IX2)
  629. 12042 LN=INSTR(M$," "):MESCL=4
  630. 12045 MESLN=1:MESWD$=LEFT$(M$,LN-1)+"の明細を表示します。変更も可能です。"
  631. 12050 GOSUB *MES:
  632. 12060 STP2=CHOINDX(IX2):LPT2=CHOINDX(IX2+1)-1:CJL=(LPT2-STP2)+1
  633. 12070 *FCR01 CLS 2:CJ=1:COP=0:CX=0:CY=C4
  634. 12080 MESLN=3:MESWD$="もとの画面に戻る ＰＦ２ ":GOSUB *MES
  635. 12090 *FCR0 CP=((CJ-1) \ C30)+1:IF CP=COP THEN *FCR2
  636. 12100 CLS 2:CI=(CP-1)*C30+1
  637. 12110 *FCR12 LOCATE CX+40*(((CI-1) \ C15) MOD 2),CY+((CI-1) MOD C15)
  638. 12120 PRINT USING "####";CI;:COLOR CCLN:PRINT "●";:COLOR 7
  639. 12130 GET #2,STP2+CI-1:PRINT 調理表食品名$;:CW=CVS(CSJ$)
  640. 12140 LOCATE CX+40*(((CI-1) \ C15) MOD 2)+28,CY+(CI-1) MOD C15
  641. 12150 IF CW>99999! THEN PRINT "*********"; ELSE PRINT USING  "#####.###";CW;
  642. 12160 IF (CI MOD C30)=0 OR CI=CJL THEN *FCR3 ELSE CI=CI+1:GOTO *FCR12
  643. 12170 *FCR2 LOCATE CX+40*(((COJ-1) \ C15) MOD 2),CY+(COJ-1) MOD C15
  644. 12180 PRINT USING  "####";COJ;:COLOR CCLN:PRINT "●";:COLOR 7:GOTO *FCR3
  645. 12190 *FCR3 CXX=CX+40*(((CJ-1) \ C15) MOD 2):CYY=CY+(CJ-1) MOD C15
  646. 12200 LOCATE CXX,CYY
  647. 12210 COLOR CCLN:PRINT USING "####";CJ;:PRINT "○";:COLOR 7
  648. 12220 MESLN=2:MESWD$="食品の重量を入力してください｡":GOSUB *MES
  649. 12230 *FCR4 GOSUB *INKEY
  650. 12240 IF X$>=CHR$(&H1C) AND X$<=CHR$(&H1F) THEN *FCR5
  651. 12250 IF X$="ＰＦ２" THEN KSW=0:GOTO *FCRE
  652. 12260 IF X$="終了" THEN KSW=2:GOTO *FCRE      '復帰
  653. 12270 'IF X$=CHR$(&H1B) OR X$="明細" THEN IX2=JG(CJ,1):CCLN=JG(CJ,2):GOSUB *FCR:GOTO *FCR4
  654. 12280 IF (X$>=CHR$(&H30) AND X$<=CHR$(&H39)) OR X$=CHR$(&H2E) THEN GOSUB *CBK:GOTO *FCR5
  655. 12290 KSW=0:GOTO *FCRE
  656. 12300 *FCR5 COP=CP:COJ=CJ:I=CJ:IL=CJL:GOSUB *CASCON:CJ=I:GOTO *FCR0
  657. 12310 *FCRE MESLN=0:GOSUB *MPOP:RETURN
  658. 12320 *CBK
  659. 12330 XSUINP=CXX:YSUINP=CYY:GOSUB *SUINP:CCJ=OSUINP
  660. 12340 GET #2,STP2+CJ-1:LSET CSJ$=MKS$(CCJ):PUT #2,STP2+CJ-1
  661. 12350 MFD=0:FOR NN=0 TO 14:SSE(NN)=0:NEXT NN:DT0=1:DT1=1:DT2=1
  662. 12360 SVJ=J:SVJGW=JGW:SVCSJ=CSJ:SVDSW=DSW
  663. 12370 J=JG(TJ,1):JGW=TJ:CSJ=JG(TJ,3):DSW=JG(TJ,0):GOSUB 11910:HENSW=1:GOSUB 5000
  664. 12380 J=SVJ:JGW=SVJGW:CSJ=SVCSJ:DSW=SVDSW
  665. 12390 *CBKE RETURN
  666. 12480 *ERR 
  667. 12481 IF ERL=1023 THEN RESUME *ERR1
  668. 12482 IF ERL=13210 AND ERR=63 THEN RESUME NEXT
  669. 12483 IF ERL=13210 AND ERR=64 THEN KILL "HSON.DAT":RESUME
  670. 12484 IF ERL=13310 AND ERR=63 THEN RESUME *YOME
  671. 12488 ON ERROR GOTO 0
  672. 12489 PRINT  ERR,ERL:END
  673. 12490 *ERR1 CLEAR ,,6250:DSPSW=0:FMR=1:ON ERROR GOTO *ERR
  674. 12500 WINDOW (0,0)-(639,479-10):VIEW (0,0)-(639,399):C899=1/.899!
  675. 12505 COLOR 7,0,7,4
  676. 12510 PALETTE 1,[0,0,255]:PALETTE 2,[0,255,0]:PALETTE 3,[0,255,255]
  677. 12511 PALETTE 1,[0,0,255]:PALETTE 2,[0,255,0]:PALETTE 3,[0,255,255]
  678. 12515 PALETTE 4,[255,0,0]:PALETTE 5,[255,0,255]:PALETTE 6,[255,255,0]
  679. 12520 PALETTE 7,[255,255,255]
  680. 12550 GOTO *FBHG
  681. 12600 *SUH
  682. 12610 FOR NN=4 TO 14:SSE=0
  683. 12620 IF JGL=0 THEN 7030
  684. 12630 FOR LL=1 TO JGL:SSE=SSE+JG(LL,NN):NEXT LL
  685. 12640 LOCATE 22,C15-2+NN
  686. 12650 IF SSE>1E+06 THEN PRINT "********"; ELSE PRINT USING "######.#";SSE;
  687. 12660 NEXT NN
  688. 12670 *SUHE RETURN
  689. 12680 *ENG IF JGL=0 THEN CLS 5:GOSUB *ESW1:RETURN ELSE CLS 5
  690. 12690 FOR NN=4 TO 14:SEX(NN)=SE(NN)/50
  691. 12700 FOR LL=1 TO JGL:SEX(NN)=SEX(NN)+JG(LL,NN):NEXT LL
  692. 12710 NEXT NN
  693. 12720 RESTORE *ENGD
  694. 12730 *ENG3 
  695. 12740 FOR LL=JGL TO 1 STEP -1
  696. 12750 RESTORE *ENGD:READ NN
  697. 12760 ENGX(0)=415+70*SEX(NN)/SE(NN)*SIN(0):ENGY(0)=290-C899*70*SEX(NN)/SE(NN)*COS(0):ENGX(7)=ENGX(0):ENGY(7)=ENGY(0)
  698. 12765 PSET (ENGX(0),ENGY(0)),JG(LL,2)
  699. 12770 FOR IENG=1 TO 7:READ NN
  700. 12780 ENGX(IENG)=415+70*SEX(NN)/SE(NN)*SIN(IENG*C360/7):ENGY(IENG)=290-C899*70*SEX(NN)/SE(NN)*COS(IENG*C360/7)
  701. 12785 LINE -(ENGX(IENG),ENGY(IENG)),PSET,JG(LL,2)
  702. 12790 NEXT IENG
  703. 12800 'LINE -(ENGX(0),ENGY(0)),PSET,JG(LL,2)
  704. 12810 PAINT (415,290),JG(LL,2),JG(LL,2)
  705. 12811 FOR IENG=0 TO 6
  706. 12812 ENGX=(415+ENGX(IENG)+ENGX(IENG+1))/3:ENGY=(290+ENGY(IENG)+ENGY(IENG+1))/3
  707. 12814 PAINT (ENGX,ENGY),JG(LL,2),JG(LL,2)
  708. 12815 *ENG4 NEXT IENG
  709. 12820 FOR NN=4 TO 14:SEX(NN)=SEX(NN)-JG(LL,NN):NEXT NN
  710. 12830 NEXT LL
  711. 12840 *ENGD DATA 4,5,6,8,9,10,12,4
  712. 12850 *ENGE GOSUB *ESW1:RETURN
  713. 12860 *ESW
  714. 12870 WINDOW (248,190)-(639,390):IF TOWNS=1 THEN VIEW (248,190)-(639,390):CLS 5 ELSE VIEW (248,190/480*400)-(639,390/480*400+10)
  715. 12880 IF ESW=0 THEN ESW=1:GOSUB *ENG:GOTO *ESW1
  716. 12890 IF TOWNS=1 THEN WINDOW (0,0)-(639,479):VIEW (0,0)-(639,479) ELSE WINDOW (0,0)-(639,479-10):VIEW (0,0)-(639,399):CLS 5
  717. 12900 ESW=0:HENSW=1:GOSUB 7000:GOSUB *KLINE:GOTO *ESWE
  718. 12910 *ESW1
  719. 12920 IF FMR=1 THEN 13020
  720. 12930 CIRCLE (415,290),70,7,C899:C360=2*3.1416!
  721. 12940 SYMBOL (415+80*SIN(0)-40,290-80*COS(0)-8),"エネルギー",1,1,7
  722. 12950 SYMBOL (415+80*SIN(C360/7),290-80*COS(C360/7)-8),"たんぱく質",1,1,7
  723. 12960 SYMBOL (415+80*SIN(2*C360/7),290-80*COS(2*C360/7)-8),"カルシューム",1,1,7
  724. 12970 SYMBOL (415+80*SIN(3*C360/7),290-80*COS(3*C360/7)-8),"ＶＡ",1,1,7
  725. 12980 SYMBOL (415+80*SIN(4*C360/7)-10-24,290-80*COS(4*C360/7)-8),"ＶＢ１",1,1,7
  726. 12990 SYMBOL (415+80*SIN(5*C360/7)-16-24,290-80*COS(5*C360/7)-8),"ＶＢ２",1,1,7
  727. 13000 SYMBOL (415+80*SIN(6*C360/7)-8-16,290-80*COS(6*C360/7)-8),"ＶＣ",1,1,7
  728. 13010 GOTO 13110
  729. 13020 CIRCLE (415,290),70,7,C899:C360=2*3.1416!
  730. 13030 SYMBOL@ (415+80*SIN(0)-40,290-12-C899*(80*COS(0)-8)),"エネルギー",1,1,7
  731. 13040 SYMBOL@ (415+80*SIN(C360/7),290-12-C899*(80*COS(C360/7)-8)),"たんばく質",1,1,7
  732. 13050 SYMBOL@ (415+80*SIN(2*C360/7),290-12-C899*(80*COS(2*C360/7)-8)),"カルシュウム",1,1,7
  733. 13060 SYMBOL@ (415+80*SIN(3*C360/7),290-12-C899*(80*COS(3*C360/7)-8)),"ＶＡ",1,1,7
  734. 13070 SYMBOL@ (415+80*SIN(4*C360/7)-10-24,290-12-C899*(80*COS(4*C360/7)-8)),"ＶＢ１",1,1,7
  735. 13080 SYMBOL@ (415+80*SIN(5*C360/7)-16-24,290-12-C899*(80*COS(5*C360/7)-8)),"ＶＢ２",1,1,7
  736. 13090 SYMBOL@ (415+80*SIN(6*C360/7)-8-16,290-12-C899*(80*COS(6*C360/7)-8)),"ＶＣ",1,1,7
  737. 13110 *ESWE RETURN
  738. 13200 *HOZON
  739. 13205 IF JGL=0 THEN *HOZONE
  740. 13210 NAME "HSON.DAT" AS "HSON.BAK"
  741. 13220 OPEN "HSON.DAT" FOR OUTPUT AS #4:PRINT #4,JGL
  742. 13230 FOR HLL=1 TO JGL:FOR HNN=0 TO 3
  743. 13240 PRINT #4,JG(HLL,HNN)
  744. 13250 NEXT HNN:NEXT HLL:CLOSE #4
  745. 13260 *HOZONE RETURN
  746. 13300 *YOM
  747. 13310 OPEN "HSON.DAT" FOR INPUT AS #4
  748. 13320 INPUT #4,YSU:JGL=0
  749. 13330 FOR HI=1 TO YSU
  750. 13340 INPUT #4,DSW,J,WW,CSJ
  751. 13350 GOSUB 2991
  752. 13360 NEXT HI:CLOSE #4
  753. 13370 *YOME RETURN
  754. 13400 '1文字入力ルーチン
  755. 13410 *INKEY1
  756. 13420 OINWX$=INWX$:INWX$=""
  757. 13430 FOR IW=1 TO INWC
  758. 13440 *INKEY11 W$=INKEY$:IF W$="" THEN *INKEY11
  759. 13450   IF W$=CHR$(&H0D) THEN *INKEY12
  760. 13460   INWX$=INWX$+W$
  761. 13470 NEXT IW
  762. 13480 *INKEY12 W$=INKEY$:IF W$<>"" THEN *INKEY12
  763. 13490 INWC=1:X$=INWX$
  764. 13500 RETURN
  765.